home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / elib-006.lha / elib-0.06 / library / avltree.el next >
Lisp/Scheme  |  1993-01-24  |  15KB  |  577 lines
  1. ;;;; $Id: avltree.el,v 0.5 1992/08/19 01:57:26 ceder Exp $
  2. ;;;; This file implements balanced binary trees, AVL-trees.
  3. ;;;;
  4. ;;;; Copyright (C) 1991, 1992 Free Software Foundation
  5. ;;;;
  6. ;;;; This file is part of the GNU Emacs lisp library, Elib.
  7. ;;;;
  8. ;;;; GNU Elib is free software; you can redistribute it and/or modify
  9. ;;;; it under the terms of the GNU General Public License as published by
  10. ;;;; the Free Software Foundation; either version 1, or (at your option)
  11. ;;;; any later version.
  12. ;;;;
  13. ;;;; GNU Elib is distributed in the hope that it will be useful,
  14. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;;;; GNU General Public License for more details.
  17. ;;;;
  18. ;;;; You should have received a copy of the GNU General Public License
  19. ;;;; along with GNU Emacs; see the file COPYING.  If not, write to
  20. ;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21. ;;;; 
  22. ;;;; Initial author:     Thomas Bellman           
  23. ;;;;             Lysator Computer Club 
  24. ;;;;              Linkoping University  
  25. ;;;;              Sweden               
  26. ;;;;
  27. ;;;; Bugfixes and completion: Inge Wallin
  28. ;;;;
  29.  
  30.  
  31. ;;;
  32. ;;; An AVL tree is a nearly-perfect balanced binary tree.  A tree
  33. ;;; consists of two cons cells, the first one holding the tag
  34. ;;; 'AVLTREE in the car cell, and the second one having the tree
  35. ;;; in the car and the compare function in the cdr cell.  The tree has
  36. ;;; a dummy node as its root with the real tree in the left pointer.
  37. ;;; 
  38. ;;; Each node of the tree consists of one data element, one left
  39. ;;; sub-tree and one right sub-tree.  Each node also has a balance
  40. ;;; count, which is the difference in depth of the left and right
  41. ;;; sub-trees. 
  42. ;;;
  43.  
  44.  
  45. (require 'elib-node)
  46. (require 'stack-m)
  47.  
  48. (provide 'avltree)
  49.  
  50.  
  51. ;;; ================================================================
  52. ;;;        Functions and macros handling an AVL tree node.
  53.  
  54. ;;
  55. ;; The rest of the functions needed here can be found in
  56. ;; elib-node.el.
  57. ;;
  58.  
  59.  
  60. (defmacro elib-avl-node-create (left right data balance)
  61.  
  62.   ;; Create and return an avl-tree node.
  63.   (` (vector (, left) (, right) (, data) (, balance))))
  64.  
  65.  
  66. (defmacro elib-avl-node-balance (node)
  67.  
  68.   ;; Return the balance field of a node.
  69.   (` (aref (, node) 3)))
  70.  
  71.  
  72. (defmacro elib-avl-node-set-balance (node newbal)
  73.  
  74.   ;; Set the balance field of a node.
  75.   (` (aset (, node) 3 (, newbal))))
  76.  
  77.  
  78.  
  79. ;;; ================================================================
  80. ;;;       Internal functions for use in the AVL tree package
  81.  
  82. ;;;
  83. ;;; The functions and macros in this section all start with `elib-avl-'.
  84. ;;;
  85.  
  86.  
  87. (defmacro elib-avl-root (tree)
  88.  
  89.   ;; Return the root node for an avl-tree.  INTERNAL USE ONLY.
  90.   (` (elib-node-left (car (cdr (, tree))))))
  91.  
  92.  
  93. (defmacro elib-avl-dummyroot (tree)
  94.  
  95.   ;; Return the dummy node of an avl-tree.  INTERNAL USE ONLY.
  96.  
  97.   (` (car (cdr (, tree)))))
  98.  
  99.  
  100. (defmacro elib-avl-cmpfun (tree)
  101.  
  102.   ;; Return the compare function of AVL tree TREE.  INTERNAL USE ONLY.
  103.   (` (cdr (cdr (, tree)))))
  104.  
  105.  
  106. ;; ----------------------------------------------------------------
  107. ;;                          Deleting data
  108.  
  109.  
  110. (defun elib-avl-del-balance1 (node branch)
  111.  
  112.   ;; Rebalance a tree and return t if the height of the tree has shrunk.
  113.   (let* ((br (elib-node-branch node branch))
  114.      p1
  115.      b1
  116.      p2
  117.      b2 
  118.      result)
  119.     (cond
  120.      ((< (elib-avl-node-balance br) 0)
  121.       (elib-avl-node-set-balance br 0)
  122.       t)
  123.  
  124.      ((= (elib-avl-node-balance br) 0)
  125.       (elib-avl-node-set-balance br +1)
  126.       nil)
  127.  
  128.      (t                    ; Rebalance
  129.       (setq p1 (elib-node-right br)
  130.         b1 (elib-avl-node-balance p1))
  131.       (if (>= b1 0)
  132.       ;; Single RR rotation
  133.       (progn
  134.         (elib-node-set-right br (elib-node-left p1))
  135.         (elib-node-set-left p1 br)
  136.         (if (= 0 b1)
  137.         (progn
  138.           (elib-avl-node-set-balance br +1)
  139.           (elib-avl-node-set-balance p1 -1)
  140.           (setq result nil))
  141.           (elib-avl-node-set-balance br 0)
  142.           (elib-avl-node-set-balance p1 0)
  143.           (setq result t))
  144.         (elib-node-set-branch node branch p1)
  145.         result)
  146.  
  147.     ;; Double RL rotation
  148.     (setq p2 (elib-node-left p1)
  149.           b2 (elib-avl-node-balance p2))
  150.     (elib-node-set-left p1 (elib-node-right p2))
  151.     (elib-node-set-right p2 p1)
  152.     (elib-node-set-right br (elib-node-left p2))
  153.     (elib-node-set-left p2 br)
  154.     (if (> b2 0)
  155.         (elib-avl-node-set-balance br -1)
  156.       (elib-avl-node-set-balance br 0))
  157.     (if (< b2 0)
  158.         (elib-avl-node-set-balance p1 +1)
  159.       (elib-avl-node-set-balance p1 0))
  160.     (elib-node-set-branch node branch p2)
  161.     (elib-avl-node-set-balance p2 0)
  162.     t)
  163.       ))
  164.     ))
  165.  
  166.  
  167. (defun elib-avl-del-balance2 (node branch)
  168.  
  169.   (let* ((br (elib-node-branch node branch))
  170.      p1
  171.      b1
  172.      p2 
  173.      b2 
  174.      result)
  175.     (cond
  176.      ((> (elib-avl-node-balance br) 0)
  177.       (elib-avl-node-set-balance br 0)
  178.       t)
  179.  
  180.      ((= (elib-avl-node-balance br) 0)
  181.       (elib-avl-node-set-balance br -1)
  182.       nil)
  183.  
  184.      (t                    ; Rebalance
  185.       (setq p1 (elib-node-left br)
  186.         b1 (elib-avl-node-balance p1))
  187.       (if (<= b1 0)
  188.       ;; Single LL rotation
  189.       (progn
  190.         (elib-node-set-left br (elib-node-right p1))
  191.         (elib-node-set-right p1 br)
  192.         (if (= 0 b1)
  193.         (progn
  194.           (elib-avl-node-set-balance br -1)
  195.           (elib-avl-node-set-balance p1 +1)
  196.           (setq result nil))
  197.           (elib-avl-node-set-balance br 0)
  198.           (elib-avl-node-set-balance p1 0)
  199.           (setq result t))
  200.         (elib-node-set-branch node branch p1)
  201.         result)
  202.  
  203.     ;; Double LR rotation
  204.     (setq p2 (elib-node-right p1)
  205.           b2 (elib-avl-node-balance p2))
  206.     (elib-node-set-right p1 (elib-node-left p2))
  207.     (elib-node-set-left p2 p1)
  208.     (elib-node-set-left br (elib-node-right p2))
  209.     (elib-node-set-right p2 br)
  210.     (if (< b2 0)
  211.         (elib-avl-node-set-balance br +1)
  212.       (elib-avl-node-set-balance br 0))
  213.     (if (> b2 0)
  214.         (elib-avl-node-set-balance p1 -1)
  215.       (elib-avl-node-set-balance p1 0))
  216.     (elib-node-set-branch node branch p2)
  217.     (elib-avl-node-set-balance p2 0)
  218.     t)
  219.       ))
  220.     ))
  221.  
  222.  
  223. (defun elib-avl-do-del-internal (node branch q)
  224.  
  225.   (let* ((br (elib-node-branch node branch)))
  226.       (if (elib-node-right br)
  227.       (if (elib-avl-do-del-internal br +1 q)
  228.           (elib-avl-del-balance2 node branch))
  229.     (elib-node-set-data q (elib-node-data br))
  230.     (elib-node-set-branch node branch
  231.                   (elib-node-left br))
  232.     t)))
  233.  
  234.  
  235.  
  236. (defun elib-avl-do-delete (cmpfun root branch data)
  237.  
  238.   ;; Return t if the height of the tree has shrunk.
  239.   (let* ((br (elib-node-branch root branch)))
  240.     (cond
  241.      ((null br)
  242.       nil)
  243.  
  244.      ((funcall cmpfun data (elib-node-data br))
  245.       (if (elib-avl-do-delete cmpfun br 0 data)
  246.       (elib-avl-del-balance1 root branch)))
  247.  
  248.      ((funcall cmpfun (elib-node-data br) data)
  249.       (if (elib-avl-do-delete cmpfun br 1 data)
  250.       (elib-avl-del-balance2 root branch)))
  251.  
  252.      (t
  253.       ;; Found it.  Let's delete it.
  254.       (cond
  255.        ((null (elib-node-right br))
  256.     (elib-node-set-branch root branch (elib-node-left br))
  257.     t)
  258.  
  259.        ((null (elib-node-left br))
  260.     (elib-node-set-branch root branch (elib-node-right br))
  261.     t)
  262.  
  263.        (t
  264.     (if (elib-avl-do-del-internal br 0 br)
  265.         (elib-avl-del-balance1 root branch)))))
  266.      )))
  267.  
  268.  
  269. ;; ----------------------------------------------------------------
  270. ;;                           Entering data
  271.  
  272.  
  273.  
  274. (defun elib-avl-enter-balance1 (node branch)
  275.  
  276.   ;; Rebalance a tree and return t if the height of the tree has grown.
  277.   (let* ((br (elib-node-branch node branch))
  278.      p1
  279.      p2
  280.      b2 
  281.      result)
  282.     (cond
  283.      ((< (elib-avl-node-balance br) 0)
  284.       (elib-avl-node-set-balance br 0)
  285.       nil)
  286.  
  287.      ((= (elib-avl-node-balance br) 0)
  288.       (elib-avl-node-set-balance br +1)
  289.       t)
  290.  
  291.      (t
  292.       ;; Tree has grown => Rebalance
  293.       (setq p1 (elib-node-right br))
  294.       (if (> (elib-avl-node-balance p1) 0)
  295.       ;; Single RR rotation
  296.       (progn
  297.         (elib-node-set-right br (elib-node-left p1))
  298.         (elib-node-set-left p1 br)
  299.         (elib-avl-node-set-balance br 0)
  300.         (elib-node-set-branch node branch p1))
  301.  
  302.     ;; Double RL rotation
  303.     (setq p2 (elib-node-left p1)
  304.           b2 (elib-avl-node-balance p2))
  305.     (elib-node-set-left p1 (elib-node-right p2))
  306.     (elib-node-set-right p2 p1)
  307.     (elib-node-set-right br (elib-node-left p2))
  308.     (elib-node-set-left p2 br)
  309.     (if (> b2 0)
  310.         (elib-avl-node-set-balance br -1)
  311.       (elib-avl-node-set-balance br 0))
  312.     (if (< b2 0)
  313.         (elib-avl-node-set-balance p1 +1)
  314.       (elib-avl-node-set-balance p1 0))
  315.     (elib-node-set-branch node branch p2))
  316.       (elib-avl-node-set-balance (elib-node-branch node branch) 0)
  317.       nil))
  318.     ))
  319.  
  320.  
  321. (defun elib-avl-enter-balance2 (node branch)
  322.  
  323.   ;; Return t if the tree has grown.
  324.   (let* ((br (elib-node-branch node branch))
  325.      p1
  326.      p2 
  327.      b2)
  328.     (cond
  329.      ((> (elib-avl-node-balance br) 0)
  330.       (elib-avl-node-set-balance br 0)
  331.       nil)
  332.  
  333.      ((= (elib-avl-node-balance br) 0)
  334.       (elib-avl-node-set-balance br -1)
  335.       t)
  336.  
  337.      (t    
  338.       ;; Balance was -1 => Rebalance
  339.       (setq p1 (elib-node-left br))
  340.       (if (< (elib-avl-node-balance p1) 0)
  341.       ;; Single LL rotation
  342.       (progn
  343.         (elib-node-set-left br (elib-node-right p1))
  344.         (elib-node-set-right p1 br)
  345.         (elib-avl-node-set-balance br 0)
  346.         (elib-node-set-branch node branch p1))
  347.  
  348.     ;; Double LR rotation
  349.     (setq p2 (elib-node-right p1)
  350.           b2 (elib-avl-node-balance p2))
  351.     (elib-node-set-right p1 (elib-node-left p2))
  352.     (elib-node-set-left p2 p1)
  353.     (elib-node-set-left br (elib-node-right p2))
  354.     (elib-node-set-right p2 br)
  355.     (if (< b2 0)
  356.         (elib-avl-node-set-balance br +1)
  357.       (elib-avl-node-set-balance br 0))
  358.     (if (> b2 0)
  359.         (elib-avl-node-set-balance p1 -1)
  360.       (elib-avl-node-set-balance p1 0))
  361.     (elib-node-set-branch node branch p2))
  362.       (elib-avl-node-set-balance (elib-node-branch node branch) 0)
  363.       nil))
  364.     ))
  365.  
  366.  
  367. (defun elib-avl-do-enter (cmpfun root branch data)
  368.  
  369.   ;; Return t if height of tree ROOT has grown.  INTERNAL USE ONLY.
  370.   (let ((br (elib-node-branch root branch)))
  371.     (cond
  372.      ((null br)
  373.       ;; Data not in tree, insert it
  374.       (elib-node-set-branch root branch
  375.                 (elib-avl-node-create nil nil data 0))
  376.       t)
  377.  
  378.      ((funcall cmpfun data (elib-node-data br))
  379.       (and (elib-avl-do-enter cmpfun
  380.                   br
  381.                   0 data)
  382.        (elib-avl-enter-balance2 root branch)))
  383.  
  384.      ((funcall cmpfun (elib-node-data br) data)
  385.       (and (elib-avl-do-enter cmpfun
  386.                   br
  387.                   1 data)
  388.        (elib-avl-enter-balance1 root branch)))
  389.  
  390.      (t
  391.       (elib-node-set-data br data)
  392.       nil))))
  393.  
  394.  
  395. ;; ----------------------------------------------------------------
  396.  
  397.  
  398. (defun elib-avl-mapc (map-function root)
  399.   ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
  400.   ;; The function is applied in-order.
  401.   ;;
  402.   ;; Note: MAP-FUNCTION is applied to the node and not to the data itself.
  403.   ;; INTERNAL USE ONLY.
  404.  
  405.   (let ((node root)
  406.     (stack (elib-stack-create))
  407.     (go-left t))
  408.     (elib-stack-push stack nil)
  409.     (while node
  410.       (if (and go-left
  411.            (elib-node-left node))
  412.       (progn                   ; Do the left subtree first.
  413.         (elib-stack-push stack node)
  414.         (setq node (elib-node-left node)))
  415.     (funcall map-function node)           ; Apply the function...
  416.     (if (elib-node-right node)           ; and do the right subtree.
  417.         (setq node (elib-node-right node)
  418.           go-left t)
  419.       (setq node (elib-stack-pop stack)
  420.         go-left nil))))))
  421.  
  422.  
  423. (defun elib-avl-do-copy (root)
  424.   ;; Copy the tree with ROOT as root.
  425.   ;; Highly recursive. INTERNAL USE ONLY.
  426.   (if (null root) 
  427.       nil
  428.     (elib-avl-node-create (elib-avl-do-copy (elib-node-left root))
  429.               (elib-avl-do-copy (elib-node-right root))
  430.               (elib-node-data root)
  431.               (elib-avl-node-balance root))))
  432.  
  433.  
  434.  
  435. ;;; ================================================================
  436. ;;;       The public functions which operate on AVL trees.
  437.  
  438.  
  439. (defun avltree-create (compare-function)
  440.   "Create an empty avl tree.
  441. COMPARE-FUNCTION is a function which takes two arguments, A and B,
  442. and returns non-nil if A is less than B, and nil otherwise."
  443.   (cons 'AVLTREE
  444.     (cons (elib-avl-node-create nil nil nil 0)
  445.           compare-function)))
  446.  
  447.  
  448. (defun avltree-p (obj)
  449.   "Return t if OBJ is an avl tree, nil otherwise."
  450.   (eq (car-safe obj) 'AVLTREE))
  451.  
  452.  
  453. (defun avltree-compare-function (tree)
  454.   "Return the comparision function for the avl tree TREE."
  455.   (elib-avl-cmpfun tree))
  456.  
  457.  
  458. (defun avltree-empty (tree)
  459.   "Return t if TREE is emtpy, otherwise return nil."
  460.   (null (elib-avl-root tree)))
  461.  
  462.  
  463. (defun avltree-enter (tree data)
  464.   "In the avl tree TREE insert DATA.
  465. Return DATA."
  466.  
  467.   (elib-avl-do-enter (elib-avl-cmpfun tree)
  468.              (elib-avl-dummyroot tree)
  469.              0
  470.              data)
  471.   data)
  472.  
  473.  
  474. (defun avltree-delete (tree data)
  475.   "From the avl tree TREE, delete DATA.
  476. Return the element in TREE which matched DATA, nil if no element matched."
  477.  
  478.   (elib-avl-do-delete (elib-avl-cmpfun tree)
  479.               (elib-avl-dummyroot tree)
  480.               0
  481.               data))
  482.  
  483.  
  484. (defun avltree-member (tree data)
  485.   "Return the element in the avl tree TREE which matches DATA.
  486. Matching uses the compare function previously specified in `avltree-create'
  487. when TREE was created.
  488.  
  489. If there is no such element in the tree, the value is nil."
  490.  
  491.   (let ((node (elib-avl-root tree))
  492.     (compare-function (elib-avl-cmpfun tree))
  493.     found)
  494.     (while (and node 
  495.         (not found))
  496.       (cond
  497.        ((funcall compare-function data (elib-node-data node))
  498.     (setq node (elib-node-left node)))
  499.        ((funcall compare-function (elib-node-data node) data)
  500.     (setq node (elib-node-right node)))
  501.        (t 
  502.     (setq found t))))
  503.  
  504.     (if node
  505.     (elib-node-data node)
  506.       nil)))
  507.  
  508.  
  509.  
  510. (defun avltree-map (__map-function__ tree)
  511.   "Apply MAP-FUNCTION to all elements in the avl tree TREE."
  512.   (elib-avl-mapc
  513.    (function (lambda (node)
  514.            (elib-node-set-data node
  515.                    (funcall __map-function__
  516.                         (elib-node-data node)))))
  517.    (elib-avl-root tree)))
  518.  
  519.  
  520.  
  521. (defun avltree-first (tree)
  522.   "Return the first element in TREE, or nil if TREE is empty."
  523.  
  524.   (let ((node (elib-avl-root tree)))
  525.     (if node
  526.     (progn
  527.       (while (elib-node-left node)
  528.         (setq node (elib-node-left node)))
  529.       (elib-node-data node))
  530.       nil)))
  531.  
  532.  
  533. (defun avltree-last (tree)
  534.   "Return the last element in TREE, or nil if TREE is empty."
  535.   (let ((node (elib-avl-root tree)))
  536.     (if node
  537.     (progn
  538.       (while (elib-node-right node)
  539.         (setq node (elib-node-right node)))
  540.       (elib-node-data node))
  541.       nil)))
  542.  
  543.  
  544. (defun avltree-copy (tree)
  545.   "Return a copy of the avl tree TREE."
  546.   (let ((new-tree (avltree-create 
  547.            (elib-avl-cmpfun tree))))
  548.     (elib-node-set-left (elib-avl-dummyroot new-tree)
  549.             (elib-avl-do-copy (elib-avl-root tree)))
  550.     new-tree))
  551.  
  552.  
  553. (defun avltree-flatten (tree)
  554.   "Return a sorted list containing all elements of TREE."
  555.   (nreverse
  556.    (let ((treelist nil))
  557.      (elib-avl-mapc (function (lambda (node)
  558.                 (setq treelist (cons (elib-node-data node)
  559.                              treelist))))
  560.             (elib-avl-root tree))
  561.      treelist)))
  562.  
  563.  
  564. (defun avltree-size (tree)
  565.   "Return the number of elements in TREE."
  566.   (let ((treesize 0))
  567.     (elib-avl-mapc (function (lambda (data)
  568.                    (setq treesize (1+ treesize))
  569.                    data))
  570.            (elib-avl-root tree))
  571.     treesize))
  572.  
  573.  
  574. (defun avltree-clear (tree)
  575.   "Clear the avl tree TREE."
  576.   (elib-node-set-left (elib-avl-dummyroot tree) nil))
  577.